home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb1 / pro2 / vidtools.bas < prev   
BASIC Source File  |  1992-03-21  |  6KB  |  124 lines
  1. DEFINT A-Z
  2. '+==================================================================+
  3. '|                           VIDTOOLS.BAS                           |
  4. '|                                                                  |
  5. '|  A set of video routines developed by Larry Stone and the SWOCC  |
  6. '|  students of Larry Stone, CS133B, Fall Term '91, SWOCC.          |
  7. '+------------------------------------------------------------------+
  8. '
  9. '---- Declare Type used for passing arguments to the Box subroutine
  10. TYPE Frame
  11.     boxType AS INTEGER
  12.     fore    AS INTEGER
  13.     back    AS INTEGER
  14.     filClr  AS INTEGER
  15.     lftCol  AS INTEGER
  16.     rgtCol  AS INTEGER
  17.     tRow    AS INTEGER
  18.     bRow    AS INTEGER
  19. END TYPE
  20.  
  21. DECLARE FUNCTION GetMonitorSeg% ()
  22.  
  23. CONST True = -1, False = 0
  24.  
  25. '+==================================================================+
  26. '|                            SUBPROGRAMS                           |
  27. '+------------------------------------------------------------------+
  28.  
  29. '+==================================================================+
  30. '|                          Box Subprogram                          |
  31. '|                                                                  |
  32. '|  Purpose:  Creates a frame, clearing the center with the desired |
  33. '|            fill color unless Frame.filClr is 255, in which case  |
  34. '|            the frame is created without clearing the center area |
  35. '|            of the box.                                           |
  36. '|                                                                  |
  37. '|  Input:  TYPEd structured variable, Frame DIMmed as Frame.       |
  38. '|                                                                  |
  39. '|          Frame.BoxType  -  INTEGER variable 1 to 4               |
  40. '|                      ┌──┐      ╔══╗       ╒══╕       ╓──╖        |
  41. '|                 1 =  └──┘  2 = ╚══╝   3 = ╘══╛   4 = ╙──╜        |
  42. '|                                                                  |
  43. '|          Frame.fore     -  INTEGER variable, forground color     |
  44. '|          Frame.Back     -  INTEGER variable, background color    |
  45. '|          Frame.filClr   -  INTEGER variable, fill color          |
  46. '|                            (if filClr = 255 then no fill)        |
  47. '|          Frame.lftCol   -  INTEGER variable, left column of box  |
  48. '|          Frame.rgtCol   -  INTEGER variable, right column of box |
  49. '|          Frame.tRow     -  INTEGER variable, top row of box      |
  50. '|          Frame.bRow     -  INTEGER variable, bottom row of box   |
  51. '|                                                                  |
  52. '|  Subprogram variables:                                           |
  53. '|                                                                  |
  54. '|          ul  -  Upper left corner character as ASCII INTEGER     |
  55. '|          ll  -  Lower left corner character as ASCII INTEGER     |
  56. '|          ur  -  Upper right corner character as ASCII INTEGER    |
  57. '|          lr  -  Lower right corner character as ASCII INTEGER    |
  58. '|          vert - Vertical character as ASCII INTEGER value        |
  59. '|          horz - Horizontal character as ASCII INTEGER value      |
  60. '|          wide - INTEGER Distance between sides of box            |
  61. '+------------------------------------------------------------------+
  62. SUB Box (Frame AS Frame)
  63.  
  64.     '---- Define corner, vertical and horzizontal characters as INTEGERS
  65.     SELECT CASE Frame.boxType
  66.         CASE 1
  67.             ul = 218: ll = 192: ur = 191: lr = 217
  68.             vert = 179: horz = 196
  69.         CASE 2
  70.             ul = 201: ll = 200: ur = 187: lr = 188
  71.             vert = 186: horz = 205
  72.         CASE 3
  73.             ul = 213: ll = 212: ur = 184: lr = 190
  74.             vert = 179: horz = 205
  75.         CASE 4
  76.             ul = 214: ll = 211: ur = 183: lr = 189
  77.             vert = 186: horz = 196
  78.         CASE ELSE
  79.             PRINT "Undefined BoxType argument"
  80.             END
  81.     END SELECT
  82.  
  83.     '---- Define distance between box sides
  84.     wide = Frame.rgtCol - Frame.lftCol - 1
  85.  
  86.     COLOR Frame.fore, Frame.back                    'Set box color
  87.     LOCATE Frame.tRow, Frame.lftCol                 'Locate top row left col
  88.     PRINT CHR$(ul); STRING$(wide, horz); CHR$(ur)   'Print box top
  89.  
  90.     FOR N = Frame.tRow + 1 TO Frame.bRow - 1        'Loop through box sides
  91.         LOCATE N, Frame.lftCol: PRINT CHR$(vert);   'Print left side
  92.        
  93.         IF Frame.filClr <> 255 THEN                 'If fill color requested
  94.             COLOR Frame.fore, Frame.filClr          'Set fill color
  95.             PRINT SPACE$(wide);                     'Fill between sides
  96.             COLOR Frame.fore, Frame.back            'Reset box color
  97.         END IF
  98.        
  99.         LOCATE N, Frame.rgtCol: PRINT CHR$(vert);   'Print right side of box
  100.     NEXT                                            'Cook until done
  101.           
  102.     LOCATE Frame.bRow, Frame.lftCol                 'Locate box bottom left col
  103.     PRINT CHR$(ll); STRING$(wide, horz); CHR$(lr);  'Print box bottom
  104.  
  105. END SUB
  106.  
  107. '+==============================================================+
  108. '|                    GetMonitorSeg% FUNCTION                   |
  109. '|                                                              |
  110. '|  Input:  Nothing                                             |
  111. '|  Return: The function returns an integer representing the    |
  112. '|          segment of memory used to store the video map.      |
  113. '|  Note:   Monochrome systems will return &HB000               |
  114. '|          Color video cards will return &HB800                |
  115. '+--------------------------------------------------------------+
  116. FUNCTION GetMonitorSeg%
  117.  
  118.     DEF SEG = False
  119.     IF (PEEK(&H410) AND &H30) = &H30 THEN GetMonitorSeg% = &HB000 ELSE GetMonitorSeg% = &HB800
  120.     DEF SEG
  121.  
  122. END FUNCTION
  123.  
  124.